home *** CD-ROM | disk | FTP | other *** search
/ Delphi Programmer's Power Pack / Delphi Volume 1.iso / e_to_l / fbuilder / delphi / demos / eisfm.pas < prev    next >
Pascal/Delphi Source File  |  1996-09-15  |  7KB  |  222 lines
  1. { FormulaBuilder                }
  2. { YGB Software, Inc.            }
  3. { Copyright 1995 Clayton Collie }
  4. { All rights reserved           }
  5.  
  6. { Revised EIS Demo - Access to spreadsheet data is now handled   }
  7. { by form level methods and linked to the the onXXX events of    }
  8. { of the Expression instance                                     }
  9.  
  10. { NOTE ! - For the sake of brevity, this example does not handle }
  11. { Database variables                                             }
  12.  
  13. unit Eisfm;
  14. interface
  15. uses
  16.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  17.   StdCtrls, Forms, DBCtrls, DB, DBGrids,
  18.   SSheet,FBCOMP,FBDBCOMP,FBCALC,
  19.   Grids,DBTables, ExtCtrls, Buttons;
  20.  
  21. type
  22.   TForm2 = class(TForm)
  23.     DBGrid1: TDBGrid;
  24.     DBNavigator: TDBNavigator;
  25.     Panel1: TPanel;
  26.     DataSource1: TDataSource;
  27.     Panel2: TPanel;
  28.     Table1: TTable;
  29.     Panel3: TPanel;
  30.     SSheetGrid: TStringGrid;
  31.     GroupBox1: TGroupBox;
  32.     ResultPanel: TPanel;
  33.     FormulaEdit: TEdit;
  34.     BitBtn1: TBitBtn;
  35.     SpeedButton1: TSpeedButton;
  36.     procedure FormCreate(Sender: TObject);
  37.     procedure SSheetGridGetEditText(Sender: TObject; ACol, ARow: Longint;
  38.       var Value: OpenString);
  39.     procedure SSheetGridSetEditText(Sender: TObject; ACol, ARow: Longint;
  40.       const Value: String);
  41.     procedure FormDestroy(Sender: TObject);
  42.     procedure SpeedButton1Click(Sender: TObject);
  43.   private
  44.     { private declarations }
  45.     Sheet : TSpreadSheet;
  46.     Procedure FindVariable(const varname  : string;
  47.                            var   vtype    : byte;
  48.                            var   errcode  : integer;
  49.                            var   vardata  : longint);
  50.  
  51.     Procedure GetVariable(const varname  : string;
  52.                           var   value    : TValueRec;
  53.                           var   errcode  : integer;
  54.                                 vardata  : longint);
  55.  
  56.     Procedure SetVariable(const varname  : string;
  57.                           const value    : TValueRec;
  58.                           var   errcode  : integer;
  59.                                 vardata  : longint);
  60.   public
  61.     { public declarations }
  62.     Expression : TExpression;
  63.   end;
  64.  
  65. var
  66.   Form2: TForm2;
  67.  
  68. implementation
  69. {$R *.DFM}
  70.  
  71. {
  72. The syntax for "spreadsheet" cell access in RnCn where n is an integer,
  73. for example :
  74.  
  75.        "R1C1 * R2C2 - R5C2"
  76. }
  77.  
  78. procedure TForm2.FormCreate(Sender: TObject);
  79. var r, c   : integer;
  80.     tmpstr : String[15];
  81. begin
  82.   Table1.Open;
  83.   Sheet := TSpreadSheet.Create;
  84.   Expression := TExpression.Create(self);
  85.   With Expression do
  86.   begin
  87.     { Fields will be retrieved from Sheet }
  88.     OnFindVariable := Self.FindVariable;
  89.     OnGetVariable  := Self.GetVariable;
  90.     OnSetVariable  := Self.SetVariable;
  91.     UseEvents      := TRUE; {!!!}
  92.   end;
  93.   for r := 0 to MAXROWS do
  94.   for c := 0 to MAXCOLS do
  95.   begin
  96.     if (r + c = 0) then continue;
  97.     if (r = 0) then
  98.     begin
  99.       tmpStr := 'C' + IntToStr(c);
  100.       SSheetGrid.Cells[c,r] := tmpstr;
  101.     end
  102.    else
  103.     if (c = 0) then
  104.     begin
  105.       tmpStr := 'R'+IntToStr(r);
  106.       SSheetGrid.Cells[c,r] := tmpstr;
  107.     end
  108.    else
  109.     begin
  110.        tmpstr := FloatToStrF(Sheet.SheetData[r,c],ffCurrency,10,2);
  111.        SSheetGrid.Cells[c,r] := tmpstr;
  112.     end;
  113.   end;
  114. end;
  115.  
  116.   Procedure TForm2.FindVariable(const varname  : string;
  117.                                 var   vtype    : byte;
  118.                                 var   errcode  : integer;
  119.                                 var   vardata  : longint);
  120.   var r,c : word;
  121.   begin
  122.     if not ParseCellname(varname,r,c) then
  123.     begin
  124.       vtype := vtNONE;  { Signals that varname is invalid }
  125.       exit;
  126.     end;
  127.     { check to see if r and c are within range. If not, return an error }
  128.     if (r > MAXROWS) or (c > MAXCOLS) then
  129.     begin
  130.       errcode := EXPR_RANGE_ERROR;
  131.       Exit;
  132.     end;
  133.     { in our spreadsheet, all values are floats }
  134.     vtype := vtFLOAT;
  135.     { typecast vardata to a pointer to our actual value. This speeds }
  136.     { up variable access when the value of the cell needs to be retrieved. }
  137.     { see GetVariable function }
  138.     vardata := longint( @Sheet.sheetData[r,c] );
  139.   end;
  140.  
  141.   Procedure TForm2.GetVariable(const varname  : string;
  142.                                var   value    : TValueRec;
  143.                                var   errcode  : integer;
  144.                                      vardata  : longint);
  145.   begin
  146.     { we could retrieve the value this way :
  147.  
  148.      ParseCellName(varname,r,c);
  149.      value.vFloat := SheetData[r,c];
  150.  
  151.      but since we set vardata to point directly to the data, all we need to
  152.      do is typecast and dereference the vardata parameter (see above). This
  153.      is a bit faster, since we skip the ParseCellName function call.
  154.      }
  155.      value.vFloat := PDouble(VarData)^;
  156.      { no errors occurred so we dont have to set errcode. Its value is
  157.        EXPR_SUCCESS on entry }
  158.   end;
  159.  
  160.  
  161.  Procedure TForm2.SetVariable(const varname  : string;
  162.                               const value    : TValueRec;
  163.                               var   errcode  : integer;
  164.                                     vardata  : longint);
  165.  begin
  166.     { we could set the value this way :
  167.  
  168.      ParseCellName(varname,r,c);
  169.      SheetData[r,c] := value.vFloat;
  170.  
  171.      but since we set vardata to point directly to the data, all we need to
  172.      do is typecast and dereference the vardata parameter (see above). This
  173.      is a bit faster, since we skip the ParseCellName function call.
  174.      }
  175.      PDouble(VarData)^ := value.vFloat;
  176.      { no errors occurred so we dont have to set errcode. Its value is
  177.        EXPR_SUCCESS on entry }
  178.  end;
  179.  
  180.  
  181.  
  182. procedure TForm2.SSheetGridGetEditText(Sender: TObject; ACol,
  183.   ARow: Longint; var Value: OpenString);
  184. begin
  185.    Value := FloatToStrF(Sheet.SheetData[ARow,Acol],ffCurrency,10,2);
  186. end;
  187.  
  188. procedure TForm2.SSheetGridSetEditText(Sender: TObject; ACol,
  189.   ARow: Longint; const Value: String);
  190. var temp : double;
  191. begin
  192.   Try
  193.     Sheet.SheetData[ARow,ACol] := StrToFloat(value);
  194.   except
  195.     {}
  196.   end;
  197. end;
  198.  
  199. procedure TForm2.FormDestroy(Sender: TObject);
  200. begin
  201.  { Expression.Free; }
  202. end;
  203.  
  204. procedure TForm2.SpeedButton1Click(Sender: TObject);
  205. var stringExpr : String;
  206. begin
  207.   StringExpr := FormulaEdit.Text;
  208.   if StringExpr <> '' then
  209.   begin
  210.     Expression.Formula := StringExpr;
  211.     if Expression.Status <> EXPR_SUCCESS then
  212.     begin
  213.       MessageBeep( MB_ICONHAND );
  214.       ResultPanel.Caption := Expression.StatusText;
  215.     end
  216.      else
  217.        ResultPanel.Caption := Expression.AsString;
  218.   end;
  219. end;
  220.  
  221. end.
  222.